home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / xwordtst.arc / XWORDP.PAS < prev   
Pascal/Delphi Source File  |  1991-06-06  |  2KB  |  50 lines
  1. {$V-,A-,D-,L-}
  2. Program XWords;
  3.   uses CRT;
  4.  
  5. var
  6.    Wordfile : Text;
  7.    filenumber : String[2];
  8.    DictWord, TestWord, Exclude : string[20];
  9.    i, j, Len, LenExclude, total : integer;
  10.  
  11. begin
  12. TestWord := ParamStr(1);
  13. Exclude := ParamStr(2);
  14. Len := length(TestWord);
  15. if (len < 2) or (len > 18) then len := 2;
  16. LenExclude := Length(Exclude);
  17. str(len,FileNumber);
  18. For i := 1 to Len do TestWord[i] := Upcase(TestWord[i]);
  19. For i := 1 to LenExclude do Exclude[i] := UpCase(Exclude[i]);
  20. write('Searching WORDS'+FileNumber+' for '+TestWord+' ');
  21. Assign(Wordfile,'WORDS'+FileNumber+'.DAT');
  22. Reset(Wordfile);
  23. if LenExclude > 0 then Writeln('excluding ',Exclude) else WriteLn;
  24. while not eof(Wordfile) do begin
  25.    readln(Wordfile, DictWord);
  26.    total := 0;
  27.    if LenExclude > 0 Then Begin
  28.       For i := 1 to LenExclude do
  29.       if Pos(Exclude[i],DictWord) > 0 then Total := 1;
  30.    End;
  31.    if Total = 0 Then Begin
  32.       for i := 1 to Len do begin
  33.           if (TestWord[i] = '?') or (TestWord[i] = DictWord[i]) then Inc(total);
  34.           if total = Len then begin
  35.              For i := 1 to Len do Begin
  36.                  For j := 1 to Len do Begin
  37.                  if j<>i then if DictWord[i] = TestWord[j] then if TestWord[i] <> TestWord[j] then Textcolor(6);
  38.                  End;
  39.              End;
  40.              write(DictWord,'  ');
  41.              if wherex > 79-Len then writeln;
  42.              Textcolor(7);
  43.           end;
  44.       end;
  45.    end;
  46.  end;
  47.  Writeln;
  48.  Close(Wordfile);
  49. end.
  50.